home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr36 / lod370e.zip / PROGRAMR.ZIP / MESSGIO.PAS < prev    next >
Pascal/Delphi Source File  |  1992-12-01  |  4KB  |  181 lines
  1. unit messgio;
  2.  
  3. interface
  4.  
  5. const
  6.  max_msg_lines=100;
  7.  msys_open: boolean =false;
  8. type
  9.  message_rec=record
  10.               From: string[35];
  11.               m_to: string[35];
  12.               subject: string[72];
  13.               datetime: string[19];
  14.               timesread: word;
  15.               replyto: word;
  16.               attribute: word;
  17.               nextreply: word;
  18.               lines: integer;
  19.               text: array[1..max_msg_lines] of string[78];
  20.              end;
  21.  
  22.  message_ptr = ^message_rec;
  23.  
  24.  index_rec=record
  25.               From: string[35];
  26.               m_to: string[35];
  27.               subject: string[72];
  28.               datetime: string[19];
  29.               timesread: word;
  30.               replyto: word;
  31.               attribute: word;
  32.               nextreply: word;
  33.               lines: integer;
  34.               addr: longint;
  35.               len: word;
  36.              end;
  37.  
  38. procedure open_msys;
  39. procedure close_msys;
  40. procedure Get_Message(msgnum: word; var mr: message_rec);
  41. procedure Add_Message(var msgnum: word; var mr: message_rec);
  42. procedure Get_Message_Header(msgnum: word; var mr: message_rec);
  43. function find_highest_message: word;
  44. procedure killmessage(mnum: word);
  45.  
  46. implementation
  47.  
  48. type
  49.  mbuff=array[1..8192] of char;
  50.  mbuffptr=^mbuff;
  51. var
  52.  idxfile: file of index_Rec;
  53.  bdyfile: file;
  54.  
  55. procedure open_msys;
  56. var
  57.  tidx: index_rec;
  58. begin;
  59.  assign(idxfile,'MSGIDX.DAT');
  60.  {$I-}
  61.  reset(idxfile);
  62.  {$I+}
  63.  if ioresult<>0 then begin;
  64.   rewrite(idxfile);
  65.   reset(idxfile);
  66.  end;
  67.  assign(bdyfile,'MSGBDY.DAT');
  68.  {$i-}
  69.  reset(bdyfile,1);
  70.  {$I+}
  71.  if ioresult<>0 then begin;
  72.   rewrite(bdyfile);
  73.   reset(bdyfile,1);
  74.  end;
  75.  msys_open:=true;
  76. end;
  77.  
  78. procedure close_msys;
  79. begin;
  80.  if msys_open<>true then exit;
  81.  msys_open:=false;
  82.  close(idxfile);
  83.  close(bdyfile);
  84. end;
  85.  
  86. procedure Get_Message(msgnum: word; var mr: message_rec);
  87. var
  88.  idx: index_rec absolute mr;
  89.  tbuff: mbuffptr;
  90.  idxlen: word;
  91.  a: word;
  92. begin;
  93.  seek(idxfile,msgnum-1);
  94.  read(idxfile,idx);
  95.  idxlen:=idx.len;
  96.  mr.lines:=0;
  97.  if idxlen>0 then begin;
  98.   getmem(tbuff,idxlen);
  99.   {$I-}
  100.   seek(bdyfile,idx.addr);
  101.   {$I+}
  102.   if ioresult=0 then begin;
  103.    {$i-}
  104.    blockread(bdyfile,tbuff^,idxlen);
  105.    {$i+}
  106.    if ioresult=0 then begin;
  107.     a:=1;
  108.     mr.lines:=1;
  109.     mr.text[1]:='';
  110.     while (a<=idxlen) and (mr.lines<max_msg_lines) do begin;
  111.      if tbuff^[a]=#13 then begin;
  112.       inc(mr.lines);
  113.       mr.text[mr.lines]:='';
  114.      end else mr.text[mr.lines]:=mr.text[mr.lines]+tbuff^[a];
  115.      inc(a);
  116.     end;
  117.    end;
  118.   end;
  119.   freemem(tbuff,idxlen);
  120.  end;
  121. end;
  122.  
  123. procedure Add_Message(var msgnum: word; var mr: message_rec);
  124. var
  125.  idx: index_rec absolute mr;
  126.  idxlen,idxaddr: longint;
  127.  tbuff: mbuffptr;
  128.  a,b: word;
  129. begin;
  130.  msgnum:=filesize(idxfile);
  131.  idxaddr:=filesize(bdyfile);
  132.  idxlen:=0;
  133.  getmem(tbuff,8192);
  134.  for a:=1 to mr.lines do begin;
  135.   for b:=1 to length(mr.text[a]) do begin;
  136.    inc(idxlen);
  137.    tbuff^[idxlen]:=mr.text[a][b];
  138.   end;
  139.   inc(idxlen);
  140.   tbuff^[idxlen]:=#13;
  141.  end;
  142.  seek(bdyfile,idxaddr);
  143.  blockwrite(bdyfile,tbuff^,idxlen);
  144.  freemem(tbuff,8192);
  145.  
  146.  idx.addr:=idxaddr;
  147.  idx.len:=idxlen;
  148.  seek(idxfile,msgnum);
  149.  write(idxfile,idx);
  150.  
  151.  inc(msgnum);
  152. end;
  153.  
  154. procedure Get_Message_Header(msgnum: word; var mr: message_rec);
  155. var
  156.  idx: index_rec absolute mr;
  157. begin;
  158.  seek(idxfile,msgnum-1);
  159.  read(idxfile,idx);
  160. end;
  161.  
  162. function find_highest_message: word;
  163. begin;
  164.  find_highest_message:=filesize(idxfile);
  165. end;
  166.  
  167. procedure killmessage(mnum: word);
  168. var
  169.  idx: index_rec;
  170. begin;
  171.  seek(idxfile,mnum-1);
  172.  read(idxfile,idx);
  173.  idx.m_to:='DELETED';
  174.  idx.from:='DELETED';
  175.  idx.addr:=0;
  176.  idx.len:=0;
  177.  seek(idxfile,mnum-1);
  178.  write(idxfile,idx);
  179. end;
  180.  
  181. end.